home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / frontierMenu.tcl < prev    next >
Encoding:
Text File  |  1998-04-25  |  24.7 KB  |  907 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Frontier menu - tools for using Alpha as Frontier's external editor
  4.  # 
  5.  #  FILE: "frontierMenu.tcl"
  6.  #                                    created: 97-04-03 22.01.22 
  7.  #                                last update: 98-04-25 16.02.07 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.4
  13.  # 
  14.  # Copyright 1997, 1998 by Johan Linde
  15.  #  
  16.  # Much of the tcl code and the Frontier scripts have been written by 
  17.  # Danis Georgiadis <dmg@hyper.gr>
  18.  # 
  19.  # This software may be used freely, and distributed freely, as long as the 
  20.  # receiver is not obligated in any way by receiving it.
  21.  #  
  22.  # If you make improvements to this file, please share them!
  23.  # 
  24.  # ###################################################################
  25.  ##
  26.  
  27. if {[alpha::package vsatisfies ${alpha::version} 7.1b8]} {
  28. alpha::menu frontierMenu 2.1.4 global "•142" {} {frontierMenu} {
  29.     catch {removeMenu $frontierScriptMenu}
  30. } uninstall {
  31.     removeFile $pkg_file
  32.     removeFile "$HOME:Help:Frontier Help"
  33. } maintainer {
  34.     "Johan Linde" jl@theophys.kth.se <http://www.theophys.kth.se/~jl/Alpha.html>
  35. } help {file "Frontier Help"}
  36. } else {
  37. ;alpha::menu frontierMenu 2.1.4 "•142" in_menu {
  38. } uninstall {
  39.     removeFile $pkg_file
  40.     removeFile "$HOME:Help:Frontier Help"
  41. } maintainer {
  42.     "Johan Linde" jl@theophys.kth.se <http://www.theophys.kth.se/~jl/Alpha.html>
  43. } help {file "Frontier Help"}
  44. }
  45.  
  46. proc frontierMenu {} {}
  47. set frontierScriptMenu •144
  48.  
  49.  
  50. # Preferences
  51. newPref f autoLaunch 0 Fron
  52. newPref v BrowsePoints {{root root} {Websites websites}} Fron
  53. newPref v OpenPoints {{Websites websites} {Glossary user.html.glossary} {Templates user.html.templates}} Fron
  54.  
  55. # Register hooks
  56. hook::register closeHook frontierCloseHook
  57. hook::register savePostHook frontierSavePostHook
  58. hook::register saveasHook frontierSaveasHook
  59.  
  60. if {[alpha::package vsatisfies ${alpha::version} 7.1b1]} {
  61. proc frontierBrowseMenu {} {
  62.     global FronmodeVars
  63.     set bl {}
  64.     foreach b $FronmodeVars(BrowsePoints) {
  65.         lappend bl [lindex $b 0]
  66.     }
  67.     return [list Menu -n Browse -p frontierMenuProc -m [concat $bl [list "(-" "Browse at…" Add… Remove…]]]
  68. }
  69.  
  70. proc frontierOpenMenu {} {
  71.     global FronmodeVars
  72.     set bl {}
  73.     foreach b $FronmodeVars(OpenPoints) {
  74.         lappend bl [lindex $b 0]
  75.     }
  76.     return [list Menu -n Open -p frontierMenuProc -m [concat $bl [list "(-" "Open…" Add… Remove…]]]
  77. }
  78. } else {
  79. proc frontierBrowseMenu {} {
  80.     global FronmodeVars
  81.     set bl {}
  82.     foreach b $FronmodeVars(BrowsePoints) {
  83.         lappend bl [lindex $b 0]
  84.     }
  85.     return [list menu -n Browse -p frontierMenuProc -m [concat $bl [list "(-" "Browse at…" Add… Remove…]]]
  86. }
  87.  
  88. proc frontierOpenMenu {} {
  89.     global FronmodeVars
  90.     set bl {}
  91.     foreach b $FronmodeVars(OpenPoints) {
  92.         lappend bl [lindex $b 0]
  93.     }
  94.     return [list menu -n Open -p frontierMenuProc -m [concat $bl [list "(-" "Open…" Add… Remove…]]]
  95. }
  96. }
  97.  
  98. # Menu definition
  99. proc menu::buildFrontierMenu {} {
  100.     global frontierMenu
  101.     return [list build [list  \
  102.     "<U<O/Fswitch toFrontier" \
  103.     "<U<O/'previewPage" \
  104.     "<B<O/'publishPage" \
  105.     "<I<O/YfrontierShell" \
  106.     [frontierBrowseMenu] \
  107.     [frontierOpenMenu] \
  108.     "rebuildScriptsMenu" \
  109.     preferences…] \
  110.     frontierMenuProc "" $frontierMenu]
  111. }
  112.  
  113. menu::buildProc frontierMenu menu::buildFrontierMenu
  114. menu::buildSome frontierMenu
  115.  
  116. proc frontierMenuProc {menu item} {
  117.     global frontierMenu FronmodeVars
  118.     switch -glob $menu {
  119.         •* {
  120.             switch -glob $item {
  121.                 "switch*toFrontier" {frontierLaunch Fore}
  122.                 preferences {FronmodifyFlags}
  123.                 default {eval frontier$item}
  124.             }
  125.         }
  126.         Browse {
  127.             switch $item {
  128.                 "Browse at" {frontierBrowseAt}
  129.                 Add {frontierAddPoint Browse}
  130.                 Remove {frontierRemovePoint Browse}
  131.                 default {
  132.                     foreach b $FronmodeVars(BrowsePoints) {
  133.                         if {[lindex $b 0] == $item} {
  134.                             frontierCheckExist [lindex $b 1] $item Browse
  135.                             odbBrowse [lindex $b 1]
  136.                             break
  137.                         }
  138.                     }
  139.                 }
  140.             }
  141.         }
  142.         Open {
  143.             switch $item {
  144.                 Open {frontierOpen}
  145.                 Add {frontierAddPoint Open}
  146.                 Remove {frontierRemovePoint Open}
  147.                 default {
  148.                     foreach b $FronmodeVars(OpenPoints) {
  149.                         if {[lindex $b 0] == $item} {
  150.                             frontierCheckExist [lindex $b 1] $item Open
  151.                             frontierDoScript "edit (@[lindex $b 1])" front
  152.                             break
  153.                         }
  154.                     }
  155.                 }
  156.             }
  157.         }
  158.     }
  159. }
  160.  
  161. proc frontierCheckExist {item mitem type} {
  162.     if {[frontierDoScript defined($item)] == "false"} {
  163.         alertnote "$mitem no longer exists in the database. It is removed from the menu."
  164.         frontierDoTheRemove $type $mitem
  165.         error ""
  166.     }
  167.     
  168. }
  169. # Called by Frontier when opening a Frontier text document in Alpha.
  170. proc openFromFrontier {} {
  171.     global frontierWinList
  172.     set name [lindex [winNames -f] 0]
  173.     set name0 [stripNameCount $name]
  174.     regsub -all {\[|\]} $name0 {\\&} name0
  175.     if {[lsearch -exact $frontierWinList $name0] < 0} {lappend frontierWinList $name0}
  176. }
  177.  
  178. # If the current document is a Frontier document, it is updated in Frontier.
  179. proc frontierSavePostHook {name} {
  180.     global frontierWinList
  181.     if {[lsearch -exact $frontierWinList $name] >= 0} {
  182.         frontierLaunch
  183.         regsub -all {\\([][])} $name {\1} name
  184.         AEBuild 'LAND' ALFA FMod "----" "“${name}”"
  185.     }
  186. }
  187.  
  188. proc frontierLaunch {{b Back}} {
  189.     if {![app::isRunning LAND]} {
  190.         if {[catch {eval app::launch$b LAND}]} {
  191.             alertnote "Could not launch Frontier."
  192.             error "Launch error"
  193.         }
  194.     } elseif {$b == "Fore"} {
  195.         switchTo 'LAND'
  196.     }
  197. }
  198.  
  199. # A list of windows opened from Frontier.
  200. if {![info exists frontierWinList]} {set frontierWinList {}}
  201.  
  202. # Executes a script in Frontier.
  203. proc frontierDoScript {script {front 0} {alert 1} {queue 0}} {
  204.     if {[catch frontierLaunch]} {error "Could not launch Frontier."}
  205.     if {$queue} {
  206.         # Never switch to Frontier when queing.
  207.         dosc -c 'LAND' -q -t 30000 -s $script
  208.         return
  209.     } elseif {[catch {dosc -c 'LAND' -s $script} returnvalue]} {
  210.         if {$alert} {
  211.             alertnote "Frontier $returnvalue"
  212.             error "Frontier $returnvalue"
  213.         }
  214.         error $returnvalue
  215.     } elseif {$front == "front"} {
  216.         switchTo 'LAND'
  217.     }
  218.     return $returnvalue
  219. }
  220.  
  221. # Executes one of the scripts in Frontier, which are required to use Alpha with Frontier.
  222. proc frontierDoAlphaScript {script {queue 0}} {
  223.     global HOME frontierHasWarned
  224.     if {[catch {frontierDoScript $script 0 0 $queue} res]} {
  225.         frontierError
  226.         error $res
  227.     }
  228.     return $res
  229. }
  230.  
  231. proc frontierError {} {
  232.     global frontierHasWarned
  233.     if {![info exists frontierHasWarned]} {
  234.         alertnote "The Frontier verbs required to integrate Alpha and Frontier have not been\
  235.           properly installed. See the file 'Frontier Help.'"
  236.         edit -r -c "$HOME:Help:Frontier Help"
  237.     }
  238. }
  239.     
  240. # closeHook
  241. # If the window to be closed is a Frontier document, it is removed
  242. # from Frontier's list of open external documents.
  243. proc frontierCloseHook {name} {
  244.     global frontierWinList frontierQSWin frontierCommandHistory frontierCommandNum
  245.     if {[set where [lsearch -exact $frontierWinList $name]] >= 0} {
  246.         regsub -all {\\([][])} $name {\1} name
  247.         set frontierWinList [lreplace $frontierWinList $where $where]
  248.         catch {AEBuild 'LAND' ALFA FCls "----" "“${name}”"}
  249.     }
  250.     if {$name == $frontierQSWin} {set frontierCommandHistory ""; set frontierCommandNum 0}
  251. }
  252.  
  253. # saveasHook
  254. proc frontierSaveasHook {oldname newname} {
  255.     frontierCloseHook $oldname
  256. }
  257.  
  258.  
  259. # Does the same as 'Preview Page' in Frontier's web menu.
  260. proc frontierpreviewPage {} {
  261.     frontierPrePub viewInBrowser
  262. }
  263.  
  264. # Does the same as 'Publish Page' in Frontier's web menu.
  265. proc frontierpublishPage {} {
  266.     frontierPrePub publishPage
  267. }
  268.  
  269. proc frontierPrePub {script} {
  270.     global frontierWinList
  271.     if {![llength [winNames]]} {
  272.         alertnote "No window!"
  273.         return
  274.     }
  275.     set name [lindex [winNames -f] 0]
  276.     set name0 [stripNameCount $name]
  277.     regsub -all {\[|\]} $name0 {\\&} name0
  278.     if {[lsearch -exact $frontierWinList $name0] >= 0} {
  279.         if {[winDirty]} {
  280.             if {[set ask [askyesno -c "Save '[file tail $name]'?"]] == "yes"} {
  281.                 save
  282.             } elseif {$ask == "cancel"} {
  283.                 return
  284.             }
  285.         }
  286.         regsub -all "\"" $name0 "\\\"" name0
  287.         frontierDoScript "Alpha.${script}(\"[string tolower $name0]\")"
  288.     } else {
  289.         alertnote "Not a Frontier window."
  290.     }
  291. }
  292.  
  293. # Open a window in Frontier
  294. proc frontierOpen {} {
  295.     if {![catch {frontierGetAddress} addr]} {
  296.         frontierDoScript "edit (@$addr)" front
  297.     }
  298. }
  299.  
  300. # Browse a table in Frontier
  301. proc frontierBrowseAt {} {
  302.     if {![catch {frontierGetAddress} addr]} {
  303.         odbBrowse $addr
  304.     }
  305. }
  306.  
  307. # Add to Browse and Open submenus
  308. proc frontierAddPoint {type} {
  309.     global FronmodeVars modifiedModeVars
  310.     set values ""
  311.     while {1} {
  312.         set values [dialog -w 450 -h 130 -t "Add $type menu item" 30 10 290 30 \
  313.             -t "Location in database:" 10 40 160 60 -e [lindex $values 0] 165 40 440 55 \
  314.             -t "Menu text:" 78 70 160 90 -e [lindex $values 1] 165 70 440 85 \
  315.             -b OK 20 100 85 120 -b Cancel 105 100 170 120]
  316.         if {[lindex $values 3]} {return}
  317.         set addr [string trim [lindex $values 0]]
  318.         if {$addr == ""} {alertnote "Location is database must be specified."; continue}
  319.         set text [string trim [lindex $values 1]]
  320.         if {$text == ""} {alertnote "The menu item must be specified."; continue}
  321.         if {[frontierDoScript "defined($addr)"] == "true"} {
  322.             set ex 0
  323.             foreach b $FronmodeVars(${type}Points) {
  324.                 if {[lindex $b 0] == $text} {alertnote "A menu item '$text' already exists."; set ex 1}
  325.             }
  326.             if {!$ex} {break}
  327.         } else {
  328.             alertnote "“$addr” is not a valid database address."
  329.         }
  330.     }
  331.     lappend FronmodeVars(${type}Points) [list $text $addr]
  332.     lappend modifiedModeVars [list ${type}Points FronmodeVars]
  333.     eval [eval frontier${type}Menu]
  334. }
  335.  
  336. # Remove from Browse and Open submenus.
  337. proc frontierRemovePoint {type} {
  338.     global FronmodeVars
  339.     set points {}
  340.     foreach b $FronmodeVars(${type}Points) {
  341.         lappend points [lindex $b 0]
  342.         set pointat([lindex $b 0]) [lindex $b 1]
  343.     }
  344.     if {![llength $points] || [catch {listpick -p "Select [string tolower $type] point to remove:" -l $points} points] ||
  345.         ![llength $points]} {return}
  346.     set points [lindex $points 0]
  347.     if {[askyesno "'$points' points to '$pointat($points)'. Remove?"] != "yes"} {return}
  348.     frontierDoTheRemove $type $points
  349. }
  350.  
  351. proc frontierDoTheRemove {type points} {
  352.     global FronmodeVars modifiedModeVars
  353.     set n {}
  354.     foreach b $FronmodeVars(${type}Points) {
  355.         if {[lindex $b 0] != $points} {lappend n $b}
  356.     }
  357.     set FronmodeVars(${type}Points) $n
  358.     lappend modifiedModeVars [list ${type}Points FronmodeVars]
  359.     eval [eval frontier${type}Menu]
  360. }
  361.  
  362. proc frontierGetAddress {} {
  363.     while {1} {
  364.         if {[catch {set addr [prompt "Location in Frontier database:" ""]}]} {
  365.             error ""
  366.         } else {
  367.             set addr [string trimleft [string trim $addr] {@}]
  368.             switch [frontierDoScript "defined($addr)"] {
  369.                 "true"        {return $addr}
  370.                 "false"        {alertnote "“$addr” is not a valid database address"}
  371.                 ""            {error ""}
  372.             }
  373.         }
  374.     }
  375. }
  376.  
  377. proc FronmodifyFlags {} {
  378.     global FronmodeVars modifiedModeVars
  379.     set values [dialog -w 300 -h 110 -t "Frontier Preferences" 30 10 290 30 \
  380.         -c "Launch Frontier at startup" $FronmodeVars(autoLaunch) 10 40 290 60 \
  381.         -b OK 20 80 85 100 -b Cancel 105 80 170 100]
  382.     if {[lindex $values 2]} {return}
  383.     set i -1
  384.     foreach flag [list autoLaunch] {
  385.         global $flag
  386.         incr i
  387.         set val [lindex $values $i]
  388.         if {$FronmodeVars($flag) != $val} {
  389.             set $flag $val
  390.             set FronmodeVars($flag) $val
  391.             lappend modifiedModeVars [list $flag FronmodeVars]
  392.         }
  393.     }
  394. }
  395.  
  396. proc OdbmodifyFlags {} {
  397.     FronmodifyFlags
  398. }
  399.  
  400. proc frontierGetWin {} {
  401.     global frontierWinList frontierWinNum
  402.     if {![info exists frontierWinNum]} {set frontierWinNum 0}
  403.     if {[llength $frontierWinList] == $frontierWinNum} {
  404.         unset frontierWinNum
  405.         return ""
  406.     } else {
  407.         return [lindex $frontierWinList [expr [incr frontierWinNum] - 1]]
  408.     }
  409. }
  410.  
  411. proc frontierCloseAllWindows {} {
  412.     global frontierWinList
  413.     foreach win $frontierWinList {
  414.         regsub -all {\\([][])} $win {\1} win
  415.         bringToFront $win
  416.         setWinInfo dirty 0
  417.         killWindow
  418.     }
  419. }
  420.  
  421. #===============================================================================
  422. # Script menu
  423. # 
  424. # The code to extract a Frontier menu has been written by
  425. # Danis Georgiadis <dmg@hyper.gr>
  426. # 
  427. #===============================================================================
  428.  
  429. proc setFrontierMenuScript {menu item scpt} {
  430.     global frontierMenuScripts
  431.     if {[regexp {&$} $item]} {
  432.         set item [string trimright $item &]
  433.     } else {
  434.         regsub -all {<[BUISEO]} $item "" item
  435.         regsub {/[a-zA-Z]} $item "" item
  436.         regsub -all {[!\^].} $item "" item
  437.     }
  438.     set key [string trimright "$menu$item" …]
  439.     set frontierMenuScripts($key) $scpt
  440. }
  441.  
  442. proc frontierBuildScriptMenu {} {
  443.     global frontierScriptMenu FronmodeVars
  444.  
  445.     if {![app::isRunning LAND]} {
  446.         if {$FronmodeVars(autoLaunch)} {
  447.             app::launchBack LAND
  448.         } else {
  449.             return
  450.         }
  451.     }
  452.     currentReplyHandler frontierGetMenuReplyHandler
  453.     frontierDoAlphaScript "Alpha.getMenuSource()" 1
  454.  
  455. }
  456.  
  457. proc frontierScriptMenuProc {menu item} {
  458.     global frontierMenuScripts frontierScriptMenu
  459.     if {$menu == $frontierScriptMenu} {set menu ""}
  460.     set key "$menu$item"
  461.     frontierDoScript $frontierMenuScripts($key)
  462. }
  463.  
  464. proc frontierrebuildScriptsMenu {} {
  465.     global frontierMenuScripts
  466.     frontierLaunch
  467.     currentReplyHandler frontierInvalReplyHandler
  468.     frontierDoAlphaScript "Alpha.invalMenuSources()" 1
  469. }
  470.  
  471. proc frontierGetMenuReplyHandler {args} {
  472.     global frontierScriptMenu
  473.     if {[string range $args 12 16] == "errs:"} {
  474.         frontierError
  475.     } else {
  476.         regexp {“([^”]*)”} $args dum txt
  477.         regsub -all {\\\{} $txt "{" txt
  478.         regsub -all {\\\}} $txt "}" txt
  479.         menu -m -n $frontierScriptMenu -p frontierScriptMenuProc $txt
  480.         insertMenu $frontierScriptMenu
  481.          currentReplyHandler frontierGetDefsReplyHandler
  482.         catch {frontierDoAlphaScript "Alpha.getDefsSource()" 1}
  483.     }
  484.     return 1
  485. }
  486.  
  487. proc frontierGetDefsReplyHandler {args} {
  488.     if {[string range $args 12 16] == "errs:"} {
  489.         frontierError
  490.     } else {
  491.         regexp {“([^”]*)”} $args dum txt
  492.         regsub -all {\\\{} $txt "{" txt
  493.         regsub -all {\\\}} $txt "}" txt
  494.         catch {eval $txt}
  495.     }
  496.     message "Frontier script menu built."
  497.     return 1    
  498. }
  499.  
  500. proc frontierInvalReplyHandler {args} {
  501.     catch {unset frontierMenuScripts}
  502.     catch {frontierBuildScriptMenu}
  503.     return 1
  504. }
  505.  
  506.  
  507. #===============================================================================
  508. #
  509. # Frontier shell
  510. # 
  511. # Some ideas taken from Matlab mode by Stephen Merkowitz
  512. # 
  513. #===============================================================================
  514. set frontierQSWin "* Frontier shell *"
  515. set frontierCommandHistory ""
  516. set frontierCommandNum 0
  517.  
  518. proc frontierfrontierShell {} {
  519.     global frontierQSWin
  520.     
  521.     if {[lsearch [winNames] $frontierQSWin] >= 0} {
  522.         bringToFront $frontierQSWin
  523.     } else {
  524.         new -n $frontierQSWin -m Fron
  525.         setWinInfo -w $frontierQSWin shell 1
  526.         insertText "Welcome to Alpha's Frontier shell\r«» "
  527.     }
  528. }
  529.  
  530.  
  531. proc frontierRunQuickScript {} {
  532.     global frontierCommandHistory frontierCommandNum frontierQSWin
  533.     set pos [getPos]
  534.  
  535.     set ind [string first "«» " [getText [lineStart $pos] [nextLineStart [getPos]]]]
  536.     if {$ind >= 0} {
  537.         set lStart [expr [lineStart $pos]+$ind+2]
  538.         endOfLine
  539.         set scriptName [getText $lStart [getPos]]
  540.         if {[getPos] != [maxPos]} {
  541.             goto [maxPos]
  542.             insertText $scriptName
  543.         }
  544.         
  545.         if {[string trim $scriptName] != ""} {
  546.             catch {frontierDoScript $scriptName 0 0} result
  547.             if {[string compare [lindex $frontierCommandHistory [expr [llength $frontierCommandHistory]-1]] $scriptName] != 0} {
  548.                 lappend frontierCommandHistory $scriptName
  549.                 if {[llength $frontierCommandHistory] > 30} {
  550.                     set frontierCommandHistory [lrange $frontierCommandHistory 1 end]
  551.                 }
  552.             }
  553.             set frontierCommandNum [llength $frontierCommandHistory]
  554.         } else {
  555.             set result ""
  556.         }
  557.         if {[string length $result]} {
  558.             insertText -w $frontierQSWin "\r" $result \r "«» "
  559.         } else {
  560.             insertText -w $frontierQSWin \r "«» "
  561.         }
  562.     } else {
  563.            if {[getPos] == [maxPos]} {
  564.             insertText "«» "
  565.         } else {
  566.             bind::CarriageReturn
  567.         }
  568.     }
  569.     return
  570. }
  571.  
  572.  
  573. proc frontierPrevCommand {} {
  574.     global frontierCommandHistory frontierCommandNum
  575.     
  576.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  577.     if {[set ind [string first "«» " $text]] == 0} {
  578.         goto [expr [lineStart [getPos]] + $ind + 2]
  579.     } else return
  580.  
  581.     incr frontierCommandNum -1
  582.     if {$frontierCommandNum < 0} {
  583.         incr frontierCommandNum
  584.         endOfLine
  585.         return
  586.     }
  587.     set text [lindex $frontierCommandHistory $frontierCommandNum]
  588.     set to [nextLineStart [getPos]]
  589.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  590.     replaceText [getPos] $to $text
  591. }
  592.  
  593.  
  594. proc frontierNextCommand {} {
  595.     global frontierCommandHistory frontierCommandNum
  596.     
  597.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  598.     if {[set ind [string first "«» " $text]] == 0} {
  599.         goto [expr [lineStart [getPos]] + $ind + 2]
  600.     } else return
  601.  
  602.     incr frontierCommandNum
  603.     if {$frontierCommandNum >= [llength $frontierCommandHistory]} {
  604.         incr frontierCommandNum -1
  605.         frontierCancelLine
  606.         return
  607.     }
  608.     set text [lindex $frontierCommandHistory $frontierCommandNum]
  609.     set to [nextLineStart [getPos]]
  610.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  611.     replaceText [getPos] $to $text
  612. }
  613.  
  614. proc frontierCancelLine {} {
  615.     global frontierCommandHistory frontierCommandNum
  616.  
  617.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  618.     if {[set ind [string first "«» " $text]] == 0} {
  619.         goto [expr [lineStart [getPos]] + $ind + 3]
  620.     } else return
  621.     
  622.     set to [nextLineStart [getPos]]
  623.     deleteText [getPos] $to
  624.     
  625.     set frontierCommandNum [llength $frontierCommandHistory]
  626. }
  627.  
  628. proc frontierBol {} {
  629.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  630.     if {[set ind [string first "«» " $text]] == 0} {
  631.         goto [expr [lineStart [getPos]] + $ind + 3]
  632.     } else {
  633.         goto [lineStart [getPos]]
  634.     }
  635. }
  636.  
  637. proc Fron::OptionTitlebar {} {
  638.     global frontierCommandHistory
  639.     return $frontierCommandHistory
  640. }
  641.  
  642. proc Fron::OptionTitlebarSelect {item} {
  643.     insertText [string range $item [expr 1+[string first " " $item]] end]
  644.     if {[key::optionPressed]} {frontierRunQuickScript}
  645. }
  646.  
  647. regModeKeywords -m {«} Fron {}
  648. bind up <z> frontierPrevCommand Fron
  649. bind down <z> frontierNextCommand Fron
  650. bind '\r' frontierRunQuickScript Fron
  651. bind 'u'  <z>  frontierCancelLine  Fron
  652. bind left <c> frontierBol Fron
  653. bind 'a' <z> frontierBol Fron
  654.  
  655. #===============================================================================
  656. # Odb browser
  657. # 
  658. # Written by Danis Georgiadis <dmg@hyper.gr> and modified by me to be integrated 
  659. # with the rest.
  660. # 
  661. #===============================================================================
  662.  
  663. set odbBrowserTabLength 3
  664. set odbBrowserTypeOffset 60
  665.  
  666. proc odbget120Spaces {} {
  667.     set spaces40 "                                        "
  668.     return "$spaces40$spaces40$spaces40"
  669. }
  670.  
  671. proc odbGetIndLevel {indStr} {
  672.     global odbBrowserTabLength
  673.     return [expr [string length $indStr] / $odbBrowserTabLength]
  674. }
  675.  
  676. proc odbGetIndString {indLevel} {
  677.     global odbBrowserTabLength
  678.     return [string range [odbget120Spaces] 0 [expr [expr $indLevel * $odbBrowserTabLength] - 1]]
  679. }
  680.  
  681. proc odbGetNextIndString {thisIndStr} {
  682.     return [odbGetIndString [expr [odbGetIndLevel $thisIndStr] + 1]]
  683. }
  684.  
  685. proc odbBrowseGetLineParts {name type addr level} {
  686.     global odbBrowserTypeOffset
  687.     global odbBrowserTabLength
  688.     
  689.     set indPadPart [odbGetIndString $level]
  690.     set namePart [string trim $name "\t "]
  691.     set typePadSize [expr $odbBrowserTypeOffset - [expr [string length $indPadPart] + [string length $name]]]
  692.     set typePadPart [string range [odbget120Spaces] 0 [expr $typePadSize - 1]]
  693.     set typePart "◊$type◊"
  694.     set addrPart "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$addr∞"
  695.     
  696.     set res ""
  697.     lappend res $indPadPart $namePart $typePadPart $typePart $addrPart
  698.     
  699.     return $res
  700. }
  701.  
  702. proc odbBrowseDown {} {
  703.     set curPos [getPos]
  704.     set curLineStart [lineStart $curPos]
  705.     set curLineEnd [nextLineStart $curPos]
  706.     select $curLineStart $curLineEnd
  707.     
  708.     set newLineStart [nextLineStart $curLineStart]
  709.     set newLineEnd [nextLineStart $newLineStart]
  710.     if {$newLineStart < [maxPos]} {
  711.         select $newLineStart $newLineEnd
  712.     }
  713. }
  714.  
  715. proc odbBrowseCmdDown {{option 0}} {
  716.     set curPos [getPos]
  717.     set curLineStart [lineStart $curPos]
  718.     set curLineEnd [nextLineStart $curPos]
  719.     
  720.     if {[regexp {^( *).+◊tabl◊\t+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind addr]} {
  721.         if {[frontierDoScript "defined($addr)"] == "false"} {return}
  722.         if {$option} {killWindow}
  723.         odbBrowse $addr
  724.     }
  725. }
  726.  
  727. proc odbBrowseUp {} {
  728.     set curPos [getPos]
  729.     set curLineStart [lineStart $curPos]
  730.     set curLineEnd [nextLineStart $curPos]
  731.     select $curLineStart $curLineEnd
  732.     
  733.     set newLineStart [prevLineStart $curLineStart]
  734.     set newLineEnd [nextLineStart $newLineStart]
  735.     if {$newLineEnd > 0} {
  736.         select $newLineStart $newLineEnd
  737.     }
  738. }
  739.  
  740. proc odbBrowseCmdUp {{option 0}} {
  741.     regexp {∞(.+)∞} [getText 0 [nextLineStart 0]] junk addr
  742.     if {[set point [string last "." $addr]] >= 0} {
  743.         if {[frontierDoScript "defined($addr)"] == "false"} {return}
  744.         if {$option} {killWindow}
  745.         odbBrowse [string range $addr 0 [expr $point - 1]]
  746.     }
  747. }
  748.  
  749. proc odbBrowserAddCells {pos cells indLevel} {
  750.     
  751.     set tmp ""
  752.     set colorCodes ""
  753.     set lastPos $pos
  754.     
  755.     foreach cell $cells {
  756.         set cellName [lindex $cell 0]
  757.         set cellType [lindex $cell 1]
  758.         set cellAddr [lindex $cell 2]
  759.         
  760.         set parts [odbBrowseGetLineParts $cellName $cellType $cellAddr $indLevel]
  761.         
  762.         set indPart [lindex $parts 0]
  763.         set namePart [lindex $parts 1]
  764.         set typePartPad [lindex $parts 2]
  765.         set typePart [lindex $parts 3]
  766.         set addrPart [lindex $parts 4]
  767.         
  768.         set nameStart [expr $lastPos + [string length $indPart]]
  769.         set nameEnd [expr $nameStart + [string length $namePart]]
  770.         
  771.         if {$cellType == "TEXT" || $cellType == "wptx"} {
  772.             lappend colorCodes [concat $nameStart 3]
  773.             lappend colorCodes [concat $nameEnd 0]
  774.         } elseif {$cellType == "tabl"} {
  775.             lappend colorCodes [concat $nameStart 5]
  776.             lappend colorCodes [concat $nameEnd 0]
  777.         } else {
  778.             lappend colorCodes [concat $nameStart 1]
  779.             lappend colorCodes [concat $nameEnd 0]
  780.         }
  781.         
  782.         set typeStart [expr $lastPos + [string length $indPart] + [string length $namePart] + [string length $typePartPad]]
  783.         set typeEnd [expr $typeStart + [string length $typePart]]
  784.         lappend colorCodes [concat $typeStart 4]
  785.         lappend colorCodes [concat $typeEnd 0]
  786.         
  787.         set line ""
  788.         append line $indPart $namePart $typePartPad $typePart $addrPart "\n"
  789.         append tmp $line
  790.         
  791.         set lastPos [expr $lastPos + [string length $line]]
  792.     }
  793.     
  794.     select $pos $pos
  795.     setWinInfo read-only 0
  796.     
  797.     insertText $tmp
  798.     
  799.     foreach colorCode $colorCodes {
  800.         insertColorEscape [lindex $colorCode 0] [lindex $colorCode 1]
  801.     }
  802.     
  803.     setWinInfo dirty 0
  804.     setWinInfo read-only 1
  805.     eval sizeWin [lrange [getGeometry] 2 end]
  806. }
  807.  
  808. proc odbBrowseRight {} {
  809.     set curPos [getPos]
  810.     set curLineStart [lineStart $curPos]
  811.     set curLineEnd [nextLineStart $curPos]
  812.     
  813.     if {[regexp {^( *).+◊tabl◊\t+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind addr]} {
  814.         set nextIndString [odbGetNextIndString $ind]
  815.         set nextLineText [getText [nextLineStart $curLineStart] [nextLineStart [nextLineStart $curLineStart]]]
  816.         if {![regexp "^$nextIndString" $nextLineText junk]} {
  817.             if {[frontierDoScript "defined($addr)"] == "false"} {return}            
  818.             set cells [frontierDoAlphaScript "Alpha.getCellData(@$addr)"]
  819.             odbBrowserAddCells $curLineEnd $cells [odbGetIndLevel $nextIndString]
  820.             
  821.         }
  822.     }
  823.     
  824.     select $curLineStart $curLineEnd
  825. }
  826.  
  827. proc odbBrowseLeft {} {
  828.     set curPos [getPos]
  829.     set curLineStart [lineStart $curPos]
  830.     set curLineEnd [nextLineStart $curPos]
  831.     
  832.     if {[regexp {^( *).+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind elems]} {
  833.         set pos [nextLineStart $curLineStart]
  834.         set start $pos
  835.         set nextIndString [odbGetNextIndString $ind]
  836.         while {[regexp "^$nextIndString" [getText $pos [nextLineStart $pos]] junk]} {
  837.             set pos [nextLineStart $pos]
  838.         }
  839.         setWinInfo read-only 0
  840.         deleteText $start $pos
  841.         setWinInfo dirty 0
  842.         setWinInfo read-only 1
  843.     }
  844.     select $curLineStart $curLineEnd
  845. }
  846.  
  847. proc odbBrowseEditObj {} {
  848.     set curPos [getPos]
  849.     set curLineStart [lineStart $curPos]
  850.     set curLineEnd [nextLineStart $curPos]
  851.     
  852.     if {[regexp {^.+∞(.+)∞} [getText $curLineStart $curLineEnd] junk addr]} {
  853.         frontierDoAlphaScript "Alpha.editCell(@$addr)"
  854.     }
  855. }
  856.  
  857. proc odbBrowse {{addr root}} {
  858.     if {$addr == ""} {
  859.         return
  860.     }
  861.     
  862.     global odbBrowserTypeOffset
  863.     global odbBrowserTabLength
  864.     
  865.     set cell [frontierDoAlphaScript "Alpha.getCellData(@$addr, false)"]
  866.     set wtitle [lindex [lindex $cell 0] 2]
  867.     regsub -all {[][]} $wtitle "" wtitle
  868.     set wtitle "* Frontier “$wtitle” *"
  869.     
  870.     if {[lsearch [winNames] $wtitle] >= 0} {
  871.         bringToFront $wtitle
  872.     } else {
  873.         new -n $wtitle -g 4 42 449 300 -m Odb
  874.         setWinInfo dirty 0
  875.         odbBrowserAddCells 0 $cell 0
  876.         select 0 [nextLineStart 0]
  877.         odbBrowseRight
  878.     }
  879. }
  880.  
  881. bind '\r'        odbBrowseEditObj    Odb
  882. bind enter        odbBrowseEditObj    Odb
  883.  
  884. bind down         odbBrowseDown        Odb
  885. bind down <c>    odbBrowseCmdDown    Odb
  886. bind down <co>    {odbBrowseCmdDown 1}    Odb
  887. bind up            odbBrowseUp            Odb
  888. bind up <c>        odbBrowseCmdUp        Odb
  889. bind up <co>    {odbBrowseCmdUp 1}        Odb
  890. bind right        odbBrowseRight        Odb
  891. bind left        odbBrowseLeft        Odb
  892.  
  893. if {![info exists frontierVersion] || $frontierVersion != 2.12} {
  894.     dialog -w 400 -h 180 -t "Welcome to Frontier menu 2.1.4" 70 10 390 30 \
  895.       -t "Make sure you install all the scripts in the folder 'Frontier verbs' into Frontier.\r\
  896.       If you upgrade from a previous version make sure you install the Frontier verbs which have been updated.\r\
  897.       You find information in the file 'Frontier Help'." 10 50 390 135 \
  898.       -b OK 20 150 85 170
  899.     catch {edit -r -c "$HOME:Help:Frontier Help"}
  900.     addDef frontierVersion 2.12
  901.     set frontierHasWarned 1
  902. }
  903.  
  904.  
  905. catch {frontierBuildScriptMenu}
  906. catch {unset frontierHasWarned}
  907.